home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 7 / BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso / Files / Prog / N-P / PaintPeeker.cpt / PaintPeeker / Paint Peeker.bas < prev    next >
BASIC Source File  |  1987-04-22  |  5KB  |  155 lines
  1. 00010 Title$="Paint Peeker"
  2. 00011 Author$="Lee Willoughby"
  3. 00012 Date$="4/22/87"
  4. 00020 DIM X%(1),71 X$(719) : X%(0)=576 : X%(1)=720
  5. 00030 WINDOW OFF: COORDINATE WINDOW: DEF MOUSE=1
  6. 00040 vertical=1: horizontal=2: BoxX=0: BoxY=0
  7. 00050 fullscale=1: smallscale=2
  8. 00060 ButtonEvent=1: inEditField=2: ActivateWindow=3: CloseWindow=4
  9. 00080 UpdateWindow=5: ReturnKey=6: TabKey=7
  10. 00090 WINDOW #smallscale,,(4,28)-(244,328),3
  11. 00100 widthsmallwindow=WINDOW(2): heightsmallwindow=WINDOW(3)
  12. 00110 WINDOW #fullscale,,(248,46)-(508,328),1
  13. 00120 GOSUB "Open"
  14. 00130 GOSUB "Init Menus": APPLE MENU "About Paint Peeker..."
  15. 00140 DIALOG ON: MOUSE ON: MENU ON
  16. 00150 ON DIALOG GOSUB "Check Dialog Event"
  17. 00160 ON MOUSE GOSUB "Check Mouse Event"
  18. 00170 ON MENU GOSUB "MenuEvent"
  19. 00180 DO
  20. 00190 DialogEvent=DIALOG(0)
  21. 00200 MouseEvent=MOUSE(0)
  22. 00210 UNTIL Quit=1
  23. 00220 "MenuEvent"
  24. 00230 MENU: MenuId=MENU(0):IF MenuId=255 THEN GOSUB "About PaintPeeker": RETURN
  25. 00240 ItemId = MENU(1)
  26. 00250 ON MenuId GOSUB "File", "Windows"
  27. 00260 RETURN
  28. 00270 "File"
  29. 00280 ON ItemId GOSUB "Open", "Quit"
  30. 00290 RETURN
  31. 00300 "Open"
  32. 00310 Boxwidth=5*WINDOW(2)/12 : Boxheight=5*WINDOW(3)/12
  33. 00320 CALL SETRECT(boxrect&,0,0,Boxwidth,Boxheight)
  34. 00330 GOSUB "Get Paint File"
  35. 00340 GOSUB "Make New Box"
  36. 00350 WINDOW OUTPUT #smallscale: PICTURE (BoxX,BoxY),Box&
  37. 00360 WINDOW OUTPUT #fullscale
  38. 00370 RETURN
  39. 00380 "Quit": END
  40. 00381 "Windows"
  41. 00382 ON ItemId GOSUB "SmallScale", "FullScale"
  42. 00383 RETURN
  43. 00384 "SmallScale"
  44. 00385 WINDOW #smallscale
  45. 00386 RETURN
  46. 00387 "FullScale"
  47. 00388 WINDOW #fullscale
  48. 00389 RETURN
  49. 00399 "Check Dialog Event"
  50. 00400 DialogEvent=DIALOG(0)
  51. 00410 ON DialogEvent GOSUB "ButtonEvent", "inEditField", "ActivateWindow", "CloseWindow", "UpdateWindow", "ReturnKey", "TabKey"
  52. 00420 RETURN
  53. 00430 "ButtonEvent"
  54. 00440 RETURN
  55. 00450 "inEditField"
  56. 00460 RETURN
  57. 00470 "ActivateWindow"
  58. 00480 activate=DIALOG(ActivateWindow)
  59. 00490 WINDOW #activate
  60. 00500 RETURN
  61. 00510 "UpdateWindow" 
  62. 00520 CURSOR=4
  63. 00530 GOSUB "Make New Box": WINDOW OUTPUT#smallscale: PICTURE (BoxX,BoxY),Box&
  64. 00540 WINDOW OUTPUT#fullscale
  65. 00550 Boxwidth=5*WINDOW(2)/12 : Boxheight=5*WINDOW(3)/12 
  66. 00552 IF BoxX<0 THEN BoxX=0
  67. 00554 IF BoxY<0 THEN BoxY=0
  68. 00556 IF (BoxX+Boxwidth+1)>widthsmallwindow THEN BoxX=widthsmallwindow-1-Boxwidth
  69. 00558 IF (BoxY+Boxheight+1)>heightsmallwindow THEN BoxY=heightsmallwindow-1-Boxheight
  70. 00560 PUT (0-12*BoxX/5,0-12*BoxY/5),X%(0),PSET: REM This puts the PAINT picture
  71. 00565 GOSUB "Make New Box": WINDOW OUTPUT#smallscale
  72. 00570 IF DIALOG(UpdateWindow)=smallscale THEN PUT (0,0)-(240,300),X%(0),PSET: REM Draw a scaled down version
  73. 00580 PICTURE (BoxX,BoxY),Box&
  74. 00590 WINDOW OUTPUT#fullscale
  75. 00600 CURSOR=0
  76. 00610 RETURN
  77. 00620 "CloseWindow"
  78. 00630 Quit=1
  79. 00640 RETURN
  80. 00650 "ReturnKey"
  81. 00660 RETURN
  82. 00670 "TabKey"
  83. 00680 RETURN
  84. 00690 "Check Mouse Event"
  85. 00700 MouseEvent=MOUSE(0)
  86. 00710 LONG IF WINDOW(0)=smallscale
  87. 00720 mousex%=MOUSE(1):mousey%=MOUSE(2)
  88. 00730 CALL SETPT(mousept&,mousex%,mousey%)
  89. 00740 WINDOW OUTPUT#1
  90. 00750 Boxwidth=5*WINDOW(2)/12 : Boxheight=5*WINDOW(3)/12
  91. 00760 CALL SETRECT(boxrect&,BoxX,BoxY,BoxX+Boxheight,BoxY+Boxheight)
  92. 00770 WINDOW OUTPUT #2: TEXT,,,0
  93. 00780 LONG IF FN PTINRECT(mousept&,boxrect&)
  94. 00790 Xdiff=mousex%-BoxX: Ydiff=mousey%-BoxY
  95. 00800 GOSUB "Make New Box"
  96. 00810 DO
  97. 00820 PICTURE (BoxX,BoxY),Box&
  98. 00830 BoxX=(MOUSE(1)-Xdiff):BoxY=(MOUSE(2)-Ydiff)
  99. 00840 IF BoxX<0 THEN BoxX=0
  100. 00850 IF BoxY<0 THEN BoxY=0
  101. 00860 IF (BoxX+Boxwidth+1)>widthsmallwindow THEN BoxX=widthsmallwindow-1-Boxwidth
  102. 00870 IF (BoxY+Boxheight+1)>heightsmallwindow THEN BoxY=heightsmallwindow-1-Boxheight
  103. 00880 WINDOW OUTPUT#fullscale
  104. 00890 PUT (0-12*BoxX/5,0-12*BoxY/5),X%(0),PSET: REM This puts the PAINT picture on the screen.
  105. 00900 WINDOW OUTPUT#smallscale
  106. 00910 PICTURE (BoxX,BoxY),Box&
  107. 00920 UNTIL MOUSE(0)=0
  108. 00930 END IF
  109. 00940 END IF
  110. 00950 RETURN
  111. 00960 "Get Paint File"
  112. 00970 REM This routine will load a MACPAINT file specified by the user
  113. 00980 A$=FILES$(1,"PNTG",,V%): IF A$="" THEN RETURN
  114. 00990 CURSOR=4: BoxX=0: BoxY=0
  115. 01000 OPEN"I",1,A$,1,V% : FL&=LOF(1)-512 : RECORD #1,512
  116. 01010 A&=VARPTR(A$) : Y&=VARPTR(X$(0)) : X&=A& : N=256
  117. 01020 FOR I=1 TO 720 : REM # of Lines in a MACPAINT Picture
  118. 01030 LONG IF N>180
  119. 01040 BLOCKMOVE X&,A&,256-N : X&=A&
  120. 01050 IF N>FL& THEN NX=FL& ELSE NX=N
  121. 01060 READ FILE #1,A&+256-N,NX : FL&=FL&-NX
  122. 01070 END IF
  123. 01080 CALL UNPACKBITS(X&,Y&,72) : N=X&-A&: REM Puts bit image in memory.
  124. 01090 NEXT
  125. 01100 CLOSE 1 
  126. 01110 WINDOW OUTPUT#2
  127. 01120 PUT (0,0)-(240,300),X%(0),PSET: REM Draw a scaled down version
  128. 01130 WINDOW OUTPUT#1
  129. 01140 PUT (0,0),X%(0),PSET: REM This puts the PAINT picture on the screen.
  130. 01150 CURSOR=0
  131. 01160 REM RETURN if end of subroutine
  132. 01170 RETURN
  133. 01180 "Make New Box"
  134. 01190 CurrentWindow=WINDOW(1): IF CurrentWindow<>fullscale THEN WINDOW OUTPUT#fullscale
  135. 01200 PICTURE ON
  136. 01210 PEN ,,,10,6
  137. 01220 BOX 0,0 TO Boxwidth,Boxheight
  138. 01230 PEN ,,,8,0
  139. 01240 PICTURE OFF, Box&
  140. 01250 IF WINDOW(1)<>CurrentWindow THEN WINDOW OUTPUT#CurrentWindow
  141. 01260 RETURN
  142. 01270 "Init Menus"
  143. 01280 MENU 1,0,1,"File"
  144. 01290 MENU 1,1,1,"/OOpen…"
  145. 01300 MENU 1,2,1,"/QQuit"
  146. 01302 MENU 2,0,1,"Windows"
  147. 01304 MENU 2,1,1,"Reduced Scale"
  148. 01306 MENU 2,2,1,"Full Scale"
  149. 01310 RETURN
  150. 01320 "About PaintPeeker"
  151. 01330 A&= FN GETNEWDIALOG(31267,0,-1)
  152. 01360 CALL MODALDIALOG(0,Item%)
  153. 01370 CALL DISPOSDIALOG(A&)
  154. 01380 RETURN
  155.